home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok22.lha / CrossRef / Cross.mod < prev    next >
Text File  |  1993-08-15  |  17KB  |  515 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.    Cross.mod
  3.   :Author.     Andreas Pahl
  4.   :Address.    Zikadenweg 22, D-1000 Berlin 19
  5.   :Phone.      (0)30/302 55 37
  6.   :Version.    1.00
  7.   :Date.       13.Juli 1989
  8.   :Copyright.  PD
  9.   :Language.   Modula
  10.   :Translator. M2Amiga v3.2d
  11.   :Contents.   CrossReference-Lister
  12.   :Bugs.       Erkennt bei Zuweisung von 0C C als Bezeichner
  13. ---------------------------------------------------------------------------*)
  14.  
  15. (*
  16.  
  17.     Ideen zur Erweiterung:
  18.     ----------------------
  19.  
  20.     - Ausgabedatei wählen können
  21.     - Zeilenbreite variabel
  22.     - Anzeigen, wo der Bezeichner definiert ist (Welches Modul, welche
  23.       Prozedur)
  24.     - Was er alles anzeigen soll, irgendwie vom Benutzer wählen lassen
  25.       (aber mit Voreinstellung)
  26.     - Mit Modlist verbinden
  27.     - Schachtelungstiefe ausgeben
  28.     - Smart-Linker auf Sourceebene
  29.     - Zu jeder Prozedur alle Bezeichner herausschreiben, die in ihr
  30.       verwendet, aber nicht deklariert werden. Hilfreich für Programm-
  31.       modifikationen und gegen unerwünschte Seiteneffekte
  32.  
  33. *)
  34.  
  35.  
  36. MODULE Cross;
  37.  
  38.  
  39. FROM FileSystem  IMPORT Lookup, Close, ReadChar, File, Response, WriteChar,
  40.                         WriteBytes;
  41. FROM InOut       IMPORT ReadString, WriteLn, WriteString, Write;
  42. FROM Arts        IMPORT BreakPoint;
  43. FROM SYSTEM      IMPORT ADR;
  44. FROM Strings     IMPORT Compare, Length;
  45. FROM ASCII       IMPORT eol,cr,lf;
  46. FROM Arguments   IMPORT GetArg, NumArgs;
  47. FROM Conversions IMPORT ValToStr;
  48.  
  49. (* AMOK-Module *)
  50. FROM MemSystem  IMPORT Allocate, Deallocate;
  51.  
  52.  
  53.  
  54. TYPE
  55.  
  56.    (* Erklärung der Datenstruktur siehe Dokumentation                     *)
  57.  
  58.    ListPointer = POINTER TO ListNode;
  59.    ListNode    = RECORD
  60.                    Nummer : CARDINAL;       (* Zeilennummer               *)
  61.                    Next   : ListPointer;
  62.                  END;
  63.  
  64.    Trie = POINTER TO Node;
  65.    Node = RECORD
  66.             Buchstabe   : CHAR;
  67.             Typ         : CHAR;             (* Typ des Bezeichners        *)
  68.             Anzahl      : CARDINAL;         (* Häufigkeit des Bezeichners *)
  69.             Erster,                         (* Liste der Zeilennummern    *)
  70.             Letzter     : ListPointer;
  71.             Wortende    : BOOLEAN;          (* Markiert Wortende im Trie  *)
  72.             horizontal,
  73.             vertikal    : Trie;
  74.           END;
  75.  
  76.    String = ARRAY [0..80] OF CHAR;
  77.  
  78.  
  79. VAR
  80.  
  81.    Ueberschrift,                            (* Length möchte Variablen    *)
  82.    Unterstreichen,
  83.    Wort           : String;                 (* enthält aktuelles Wort     *)
  84.    Ende           : BOOLEAN;                (* TRUE = Ende eines Wortes   *)
  85.    OutputFile,                              (* Ausgabe-File               *)
  86.    QuellFile      : File;                   (* zu untersuchende Source    *)
  87.    OutputName,                              (* Dos-Name des Ausgabe-Files *)
  88.    DosName        : String;                 (* Dos-Name des Sourcefiles   *)
  89.    Zeichen        : CHAR;                   (* gelesenes Zeichen          *)
  90.    Baum           : Trie;                   (* Da wird alles gespeichert  *)
  91.    ZeilenNummer   : CARDINAL;
  92.    Len            : INTEGER;                (* Für GetArg                 *)
  93.    BezeichnerTyp  : CHAR;
  94.    actual         : LONGINT;                (* Für WriteBytes             *)
  95.    AltesZeichen   : CHAR;                   (* Das vorhergehende Zeichen  *)
  96.                                             (* muß gespeichert werden, um *)
  97.                                             (* Kommentare zu erkennen     *)
  98.  
  99.  
  100.  
  101.  
  102. PROCEDURE LiesZeichen(VAR Zeichen : CHAR);
  103.  
  104. (* Liest ein Zeichen aus dem File aus, übergeht Kommentare und Strings    *)
  105. (* und erkennt das Wortende.                                              *)
  106.  
  107.  
  108.    PROCEDURE Read ( VAR Zeichen : CHAR );
  109.  
  110.    (* Liest ein Zeichen aus dem QuellFile und inkrementiert den
  111.       Zeilenzähler gegebenenfalls.                                        *)
  112.  
  113.    BEGIN
  114.       ReadChar(QuellFile,Zeichen);
  115.       IF (Zeichen = eol) OR (Zeichen = cr) THEN
  116.          INC(ZeilenNummer);
  117.       END;
  118.    END Read;
  119.  
  120.  
  121. BEGIN
  122.    Read(Zeichen);
  123.  
  124.    (* Strings sollen überlesen werden *)
  125.  
  126.    IF Zeichen = '"' THEN
  127.       REPEAT
  128.          Read(Zeichen);
  129.       UNTIL Zeichen = '"';
  130.       Read(Zeichen);
  131.    END;
  132.    IF Zeichen = "'" THEN
  133.       REPEAT
  134.          Read(Zeichen);
  135.       UNTIL Zeichen = "'";
  136.       Read(Zeichen);
  137.    END;
  138.  
  139.    (* Kommentare sollen auch überlesen werden *)
  140.  
  141.    IF (Zeichen = "*") AND (AltesZeichen = "(") THEN
  142.       REPEAT
  143.          AltesZeichen := Zeichen;
  144.          Read(Zeichen)
  145.       UNTIL (Zeichen = ")") AND (AltesZeichen = "*");
  146.    END;
  147.  
  148.    (* Tritt ein Nichtbuchstabe auf, ist das Wort beendet *)
  149.  
  150.    IF NOT (  ( (Zeichen >= 'a') AND (Zeichen <= 'z') )
  151.           OR ( (Zeichen >= 'A') AND (Zeichen <= 'Z') ) ) THEN
  152.       Ende := TRUE;
  153.    END;
  154.  
  155.    AltesZeichen := Zeichen;
  156.  
  157. END LiesZeichen;
  158.  
  159.  
  160.  
  161. PROCEDURE Insert(VAR Knoten : Trie; level : CARDINAL);
  162.  
  163. VAR
  164.  
  165.    NeuerKnoten       : Trie;                (* Knoten zum Einfügen in     *)
  166.                                             (* den Trie                   *)
  167.    NeuerListNode     : ListPointer;         (* Knoten zum Einfügen in die *)
  168.                                             (* Liste der Zeilennummern    *)
  169.  
  170.  
  171.  
  172.    PROCEDURE Wandern();
  173.  
  174.    (* Wandert im Baum eine Ebene tiefer, falls nicht das Wortende         *)
  175.    (* detektiert wurde. Zusätzlich wird der Bezeichnertyp bestimmt.       *)
  176.  
  177.  
  178.    BEGIN
  179.       LiesZeichen(Zeichen);
  180.       IF Ende = FALSE THEN
  181.          Insert(Knoten^.vertikal,level+1);
  182.       ELSE
  183.          Knoten^.Wortende := TRUE;          (* Das Wort ist beendet, am   *)
  184.                                             (* aktuellen Knoten wird dies *)
  185.                                             (* markiert.                  *)
  186.          Wort[level+1] := 0C;
  187.          IF Knoten^.Anzahl = 0 THEN         (* Wenn das Wort zum ersten   *)
  188.             Knoten^.Typ := BezeichnerTyp;   (* auftaucht, wird der Typ    *)
  189.          END;                               (* des Bezeichners gespeichert*)
  190.  
  191.                                             (* Jetzt wird getestet, ob das*)
  192.                                             (* beendete Wort, den aktu-   *)
  193.                                             (* ellen Bezeichnertyp ändert *)
  194.          IF Compare(Wort,0,Length(Wort),"FROM",TRUE) = 0 THEN
  195.             BezeichnerTyp := "F";
  196.          END;
  197.          IF Compare(Wort,0,Length(Wort),"IMPORT",TRUE) = 0 THEN
  198.             BezeichnerTyp := "I";
  199.          END;
  200.          IF Compare(Wort,0,Length(Wort),"MODULE",TRUE) = 0 THEN
  201.             BezeichnerTyp := "M";
  202.          END;
  203.          IF Compare(Wort,0,Length(Wort),"PROCEDURE",TRUE) = 0 THEN
  204.             BezeichnerTyp := "P";
  205.          END;
  206.          IF Compare(Wort,0,Length(Wort),"CONST",TRUE) = 0 THEN
  207.             BezeichnerTyp := "C";
  208.          END;
  209.          IF Compare(Wort,0,Length(Wort),"TYPE",TRUE) = 0 THEN
  210.             BezeichnerTyp := "T";
  211.          END;
  212.          IF Compare(Wort,0,Length(Wort),"VAR",TRUE) = 0 THEN
  213.             BezeichnerTyp := "V";
  214.          END;
  215.          IF Compare(Wort,0,Length(Wort),"BEGIN",TRUE) = 0 THEN
  216.             BezeichnerTyp := "B";
  217.          END;
  218.  
  219.          Knoten^.Anzahl := Knoten^.Anzahl + 1;
  220.                                             (* Zeilennummer in die Liste  *)
  221.                                             (* der Zeilennummern einfügen *)
  222.          Allocate(NeuerListNode,SIZE(ListPointer));
  223.          NeuerListNode^.Nummer := ZeilenNummer;
  224.          NeuerListNode^.Next := NIL;
  225.          IF Knoten^.Erster = NIL THEN
  226.             Knoten^.Erster  := NeuerListNode;
  227.             Knoten^.Letzter := NeuerListNode;
  228.          ELSE
  229.             Knoten^.Letzter^.Next := NeuerListNode;
  230.             Knoten^.Letzter       := NeuerListNode;
  231.          END;
  232.       END;
  233.    END Wandern;
  234.  
  235. BEGIN
  236.    IF Knoten = NIL THEN                     (* Wenn Baum leer,            *)
  237.       Allocate(NeuerKnoten,SIZE(Node));     (* dann Wurzel generieren     *)
  238.       NeuerKnoten^.Wortende := FALSE;
  239.       NeuerKnoten^.Anzahl := 0;
  240.       NeuerKnoten^.Buchstabe := Zeichen;
  241.       NeuerKnoten^.Erster := NIL;
  242.       NeuerKnoten^.Letzter := NIL;
  243.       Wort[level] := Zeichen;
  244.       Knoten := NeuerKnoten;
  245.       Wandern;
  246.    ELSIF ORD(Knoten^.Buchstabe) > ORD(Zeichen) THEN
  247.                                             (* Wenn Buchstabe > Zeichen   *)
  248.       Allocate(NeuerKnoten,SIZE(Node));
  249.       NeuerKnoten^.Wortende := FALSE;
  250.       NeuerKnoten^.Anzahl := 0;
  251.       NeuerKnoten^.Buchstabe := Zeichen;
  252.       NeuerKnoten^.Erster := NIL;
  253.       NeuerKnoten^.Letzter := NIL;
  254.       Wort[level] := Zeichen;
  255.       NeuerKnoten^.horizontal := Knoten;    (* dann neuen Knoten vor dem  *)
  256.       Knoten := NeuerKnoten;                (* alten horizontal einfügen  *)
  257.       Wandern;
  258.    ELSIF ORD(Knoten^.Buchstabe) < ORD(Zeichen) THEN
  259.                                             (* Wenn Buchstabe < Zeichen   *)
  260.                                             (* dann einen Knoten horizon- *)
  261.                                             (* tal weiterwandern          *)
  262.       Insert(Knoten^.horizontal,level);
  263.    ELSE                                     (* Wenn Buchstabe = Zeichen   *)
  264.       Wort[level] := Zeichen;               (* dann einen Knoten vertikal *)
  265.       Wandern;                              (* weiterwandern              *)
  266.    END;
  267. END Insert;
  268.  
  269.  
  270. PROCEDURE NeueZeile;
  271.  
  272. (* Geht beim OutputFile auf die nächste Zeile                             *)
  273.  
  274. BEGIN
  275.    WriteChar(OutputFile,cr);
  276.    WriteChar(OutputFile,lf);
  277. END NeueZeile;
  278.  
  279.  
  280.  
  281. PROCEDURE WriteCard(Val,Digits:CARDINAL);
  282.  
  283. (* Wandelt einen CARDINAL in einen String und schreibt ihn ins OutputFile *)
  284.  
  285.  
  286. VAR
  287.  
  288.    Error : BOOLEAN;
  289.    Str   : ARRAY [0..35] OF CHAR;
  290.  
  291. BEGIN
  292.    ValToStr(Val,FALSE,Str,10,Digits," ",Error);
  293.    IF NOT Error THEN
  294.       WriteBytes(OutputFile,ADR(Str),Length(Str),actual);
  295.    END;
  296. END WriteCard;
  297.  
  298.  
  299.  
  300. PROCEDURE PrintTrie(Knoten : Trie; level : CARDINAL);
  301.  
  302. (* Wandert rekursiv durch den Trie und gibt die Worte aus                 *)
  303.  
  304.  
  305. VAR
  306.  
  307.    Zaehler     : CARDINAL;                  (* Zählt die Nummern pro      *)
  308.                                             (* Ausgabezeile               *)
  309.    pointer     : ListPointer;               (* Zum Durchwandern der Liste *)
  310.                                             (* der Zeilennummern          *)
  311.  
  312.  
  313.  
  314.    PROCEDURE ReserviertesWort(Wort : String) : BOOLEAN;
  315.  
  316.    (* Überprüft, ob das übergebene Wort ein reservierter Bezeichner ist   *)
  317.  
  318.  
  319.    CONST
  320.  
  321.       Eintraege = 73;                  (* Anzahl der Eintraege in ResWort *)
  322.  
  323.  
  324.    VAR
  325.                        (* Darin sind die reservierten Bezeichner abgelegt *)
  326.       ResWort     : ARRAY [1..Eintraege] OF String;
  327.       Index       : CARDINAL;               (* Indexzähler für ResWort    *)
  328.       Reserviert  : BOOLEAN;
  329.       wort        : String;                 (* Length möchte einen call-  *)
  330.                                             (* by-reference, ich übergebe *)
  331.                                             (* aber nur call-by-value     *)
  332.  
  333.  
  334.    BEGIN
  335.  
  336.    (* Alle Reservierten Worte und Vordefinierten Bezeichner von Seite 5-15
  337.       des Handbuches zur Version 3.2d. Zwei fehlen aber in der Auflistung :
  338.  
  339.       FOR als Reserviertes Wort
  340.       VAL als Vordefinierter Bezeichner
  341.  
  342.    *)
  343.  
  344.      ResWort[ 1]:="AND";           ResWort[21]:="LOOP";
  345.      ResWort[ 2]:="ARRAY";         ResWort[22]:="MOD";
  346.      ResWort[ 3]:="BEGIN";         ResWort[23]:="MODULE";
  347.      ResWort[ 4]:="BY";            ResWort[24]:="NOT";
  348.      ResWort[ 5]:="CASE";          ResWort[25]:="OF";
  349.      ResWort[ 6]:="CONST";         ResWort[26]:="OR";
  350.      ResWort[ 7]:="DEFINITION";    ResWort[27]:="POINTER";
  351.      ResWort[ 8]:="DIV";           ResWort[28]:="PROCEDURE";
  352.      ResWort[ 9]:="DO";            ResWort[29]:="QUALIFIED";
  353.      ResWort[10]:="ELSE";          ResWort[30]:="RECORD";
  354.      ResWort[11]:="ELSIF";         ResWort[31]:="REPEAT";
  355.      ResWort[12]:="END";           ResWort[32]:="RETURN";
  356.      ResWort[13]:="EXIT";          ResWort[33]:="SET";
  357.      ResWort[14]:="EXPORT";        ResWort[34]:="THEN";
  358.      ResWort[15]:="FOR";           ResWort[35]:="TO";
  359.      ResWort[16]:="FROM";          ResWort[36]:="TYPE";
  360.      ResWort[17]:="IF";            ResWort[37]:="UNTIL";
  361.      ResWort[18]:="IMPLEMENTATION";ResWort[38]:="VAR";
  362.      ResWort[19]:="IMPORT";        ResWort[39]:="WHILE";
  363.      ResWort[20]:="IN";            ResWort[40]:="WITH";
  364.  
  365.      ResWort[41]:="BPOINTER";      ResWort[51]:="DEC";
  366.      ResWort[42]:="CODE";          ResWort[52]:="EXCL";
  367.      ResWort[43]:="FORWARD";       ResWort[53]:="FALSE";
  368.      ResWort[44]:="REM";           ResWort[54]:="FLOAT";
  369.      ResWort[45]:="ABS";           ResWort[55]:="HALT";
  370.      ResWort[46]:="BOOLEAN";       ResWort[56]:="HIGH";
  371.      ResWort[47]:="CAP";           ResWort[57]:="INC";
  372.      ResWort[48]:="CARDINAL";      ResWort[58]:="INCL";
  373.      ResWort[49]:="CHAR";          ResWort[59]:="INTEGER";
  374.      ResWort[50]:="CHR";           ResWort[60]:="LONGCARD";
  375.  
  376.      ResWort[61]:="LONGINT";       ResWort[66]:="ODD";
  377.      ResWort[62]:="LONGREAL";      ResWort[67]:="ORD";
  378.      ResWort[63]:="MAX";           ResWort[68]:="PROC";
  379.      ResWort[64]:="MIN";           ResWort[69]:="REAL";
  380.      ResWort[65]:="NIL";           ResWort[70]:="SIZE";
  381.  
  382.      ResWort[71]:="TRUE";          ResWort[72]:="TRUNC";
  383.      ResWort[73]:="VAL";
  384.  
  385.      wort := Wort;
  386.      Reserviert := FALSE;
  387.      Index := 1;
  388.      WHILE (Index <= Eintraege) AND NOT Reserviert DO
  389.         Reserviert := (Compare(wort,0,Length(wort),ResWort[Index],TRUE) = 0);
  390.         INC(Index);
  391.      END;
  392.      RETURN(Reserviert);
  393.    END ReserviertesWort;
  394.  
  395.  
  396.  
  397. BEGIN
  398.    IF Knoten^.Wortende = TRUE THEN
  399.       Wort[level] := Knoten^.Buchstabe;
  400.       Wort[level+1] := 0C;
  401.       IF NOT ReserviertesWort(Wort) THEN    (* Ausgabe des Wortes usw.    *)
  402.          WriteBytes(OutputFile,ADR(Wort),Length(Wort),actual);
  403.          WriteCard(Knoten^.Anzahl,25-level);
  404.          WriteBytes(OutputFile,ADR("   "),3,actual);
  405.          WriteChar(OutputFile,Knoten^.Typ);
  406.          WriteChar(OutputFile," ");
  407.          Zaehler := 0;
  408.          pointer := Knoten^.Erster;
  409.          REPEAT
  410.             IF Zaehler = 8 THEN
  411.                Zaehler := 0;
  412.                NeueZeile;
  413.                WriteBytes(OutputFile,ADR("                               "),31,actual);
  414.             END;
  415.             WriteCard(pointer^.Nummer,5);
  416.             INC(Zaehler);
  417.             pointer := pointer^.Next;
  418.          UNTIL pointer = NIL;
  419.          NeueZeile;
  420.       END;
  421.    END;
  422.    IF Knoten^.vertikal # NIL THEN           (* Es geht doch nichts über   *)
  423.       Wort[level] := Knoten^.Buchstabe;     (* eine schöne Rekursion      *)
  424.       PrintTrie(Knoten^.vertikal,level+1);
  425.    END;
  426.    IF Knoten^.horizontal # NIL THEN
  427.       Wort[level] := Knoten^.Buchstabe;
  428.       PrintTrie(Knoten^.horizontal,level);
  429.    END;
  430. END PrintTrie;
  431.  
  432.  
  433.  
  434. PROCEDURE Initialisierung();
  435.  
  436. (* Schreiben des Headers und Öffnen der Files                             *)
  437.  
  438.  
  439. BEGIN
  440.    WriteLn;
  441.    WriteString("CrossReference-Lister    V1.00         © Andreas Pahl");
  442.    WriteLn;
  443.    WriteLn;
  444.    WriteString("Sourcelisting : ");
  445.    IF NumArgs() >= 1 THEN               (* Source als Argument übergeben? *)
  446.       GetArg(1,DosName,Len);
  447.       WriteString(DosName);
  448.       WriteLn;
  449.    ELSE                                     (* sonst abfragen             *)
  450.       WriteLn;
  451.       WriteLn;
  452.       WriteString("in>");
  453.       ReadString(DosName);
  454.    END;
  455.    Lookup(QuellFile,DosName,1024,FALSE);
  456.    IF QuellFile.res # done THEN
  457.       WriteLn;
  458.       WriteString("Datei konnte nicht geöffnet werden.");
  459.       WriteLn;
  460.       HALT;
  461.    END;
  462.    WriteLn;
  463.  
  464.    WriteLn;
  465.    WriteString("Ausgabedatei : (prt: für Ausgabe auf Drucker)");
  466.    WriteLn;
  467.    WriteLn;
  468.    WriteString("out>");
  469.    ReadString(OutputName);
  470.    Lookup(OutputFile,OutputName,1024,TRUE);
  471.    IF OutputFile.res # done THEN
  472.       WriteLn;
  473.       WriteString("Datei konnte nicht geöffnet werden.");
  474.       WriteLn;
  475.       Close(QuellFile);
  476.       HALT;
  477.    END;
  478. END Initialisierung;
  479.  
  480.  
  481.  
  482. BEGIN   (* Hauptprogramm *)
  483.    Initialisierung;
  484.    Allocate(Baum,SIZE(Node));
  485.    Baum := NIL;
  486.    Ende := FALSE;
  487.    ZeilenNummer := 1;
  488.    LOOP
  489.       LiesZeichen(Zeichen);
  490.       IF QuellFile.eof THEN
  491.          EXIT;
  492.       END;
  493.       IF NOT Ende THEN
  494.          Insert(Baum,0);
  495.       END;
  496.       Ende := FALSE;
  497.    END;
  498.    Close(QuellFile);
  499.  
  500.    (* Ausgabe der Überschrift der Tabelle                                 *)
  501.    (* Warum braucht Length bloß einen call-by-reference ???               *)
  502.  
  503.    Ueberschrift := "Bezeichner           Anzahl Typ                Zeilen";
  504.    Unterstreichen := "-----------------------------------------------------------------------";
  505.  
  506.    WriteBytes(OutputFile,ADR(Ueberschrift),Length(Ueberschrift),actual);
  507.    NeueZeile;
  508.    WriteBytes(OutputFile,ADR(Unterstreichen),Length(Unterstreichen),actual);
  509.    NeueZeile;
  510.  
  511.    PrintTrie(Baum,0);
  512.  
  513.    Close(OutputFile);
  514.     END Cross.
  515.